home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-11
/
dbfedit.zip
/
DBFEDIT.PRG
< prev
Wrap
Text File
|
1993-01-04
|
6KB
|
194 lines
*╔════════════════════════════════════════════════╗
*║ DBFEDIT add/change data in a .dbf file ║
*║ by Tim L. Shafer January 1989 ║
*╚════════════════════════════════════════════════╝
mROW = ROW()
scrn = SAVESCREEN(0,0,24,80)
PARAMETERS fname
IF PCOUNT() > 0
fname = fname + '.dbf'
use &fname
ELSE
fname = ' '
accept 'Enter .dbf name to edit: ' to fname
fname = fname + '.dbf'
use &fname
ENDIF
*
set confirm on && a full field requires <CR> with this ON.
readexit(.T.) && allows up/down arrow keys to terminate a READ.
request = 0 && tells DBEDIT() what to do on each keystroke.
appending = .F. && appending flags.
appended_it = .F.
clear screen
@ 0,15 TO 4,65
@ 1,17 say 'Press <ESC> to quit. Use arrows / <CR> to move.'
@ 2,17 say ' ^Home - 1st Field ^End - Last Field'
@ 3,17 say ' ^PgUp - 1st Record ^PgDn - Last Record'
@ 5, 0, 24, 79 BOX '╒═╕│┘─└│' && tlc, tl, trc, rl, brc, bl, blc, ll
*
DECLARE mfields[FCOUNT()] && create an array to hold the field names.
AFIELDS(mfields) && fill the array with the field names.
dbedit( 6, 1, 23, 78, mfields, 'tsedit', .T., .T., .T., .T., .T., .T.)
* .T. isn't needed, but helps when changing one to a correct parameter.
use
RESTSCREEN(0,0,24,80,scrn)
@ mROW, 0 say ''
set cursor on
QUIT
*
FUNCTION tsedit
*
PARAMETERS mode, litField && these are passed from DBEDIT().
PRIVATE thedata, request
r = ROW()
c = COL()
*
request = 1
mField = mFields[litField]
keystroke = LASTKEY() && always save this to use later.
*
DO CASE
CASE mode = 0 && all keystrokes processed.
@ 5,32 SAY '═════════════' && blank out tob/eof messages
IF .NOT. appending
@ 24,32 SAY '─────────────'
ENDIF
del_stat()
request = 1
CASE mode = 1 && attempt to go above 1st record
IF appending
request = IF(appended_it, 2, 3)
appending = .F.
appended_it = .F.
ELSE
IF .NOT. EOF()
@ 5,32 say '<Top of File>'
ELSE
KEYBOARD CHR(5)
ENDIF
ENDIF
CASE mode = 2 && moved below last record
IF appending
IF keystroke = 24 .AND. .NOT. EOF()
@ 24,32 say '<Add to File>'
request = 3
ELSE
IF keystroke = 30
request = IF(appended_it, 2, 3)
appending = .F.
appended_it = .F.
ENDIF
ENDIF
ELSE
IF keystroke = 24
@ 24,32 say '<Add to File>'
appending = .T.
request = 3
ENDIF
ENDIF
del_stat()
CASE mode = 3 && The file is empty; append.
@ 5,32 say '<File Empty>'
appending = .T.
request = 3
CASE mode = 4 && keystroke exception. Act on it.
DO CASE
CASE keystroke = 27 && <ESC> = quit.
request = 0
CASE keystroke = 7 && delete key
if DELETED()
recall
else
delete
endif
del_stat()
CASE (keystroke > 31 .AND. keystroke < 127); && ASCII keys allowed as data
.AND. (appending .OR. (.NOT. EOF() .AND. LASTREC() <> 0))
KEYBOARD CHR(keystroke) && the keystroke must be forced back in.
set cursor on
thedata = &mFIELD
@ R, C GET thedata
READ
keystroke = LASTKEY() && act on the last key read.
IF keystroke <> 27 .AND. updated() && <ESC> quits & leaves field intact.
IF appending .AND. EOF()
APPEND BLANK
appended_it = .T.
ENDIF
REPLACE &mField WITH thedata
ENDIF
set cursor off
IF request <> 2
DO CASE
CASE keystroke = 5 .OR. keystroke = 18 && up arrow/PgUp
IF appending
request = IF(appended_it, 2, 3)
appending = .F.
appended_it = .F.
ELSE
KEYBOARD CHR(5) && up arrow
ENDIF
CASE keystroke = 24 && down arrow
KEYBOARD CHR(24)
CASE keystroke = 3 .AND. .NOT. appending && pg down
KEYBOARD CHR(24)
CASE keystroke = 13 .AND.;
litField < FCOUNT() && <CR>; move right
KEYBOARD CHR(4)
CASE keystroke = 13 .AND.;
litField = FCOUNT() && <CR> move down & to 1st field
KEYBOARD CHR(29) + CHR(24)
ENDCASE
ENDIF
CASE keystroke = 13 .AND. litField < FCOUNT() && <CR>; move right
KEYBOARD CHR(4)
CASE keystroke = 13 .AND. litField = FCOUNT() && <CR>; last field
KEYBOARD CHR(29) + CHR(24) && go to 1st field, next line
IF .NOT. appending .AND. EOF()
request = 3
appending = .T.
ENDIF
ENDCASE
ENDCASE
*
RETURN request
*
*┌───────────────────────────────────────────┐
*│ Show if the record is marked for deletion │
*└───────────────────────────────────────────┘
FUNCTION del_stat
*
IF DELETED()
set color to *w+/n
@ 5, 60 SAY '<** DELETED **>'
set color to
ELSE
@ 5, 60 SAY '═════════════════'
ENDIF
RETURN .T.
*